home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / EZDSL200.ZIP / EXINSDUP.DPR < prev    next >
Encoding:
Text File  |  1996-03-13  |  3.1 KB  |  134 lines
  1. program EXInsDup;
  2.   {-Example program showing how to insert duplicate data objects,
  3.     error checking has not been implemented.}
  4.  
  5. {$I EZDSLDEF.INC}
  6. {---Place any compiler options you require here-----------------------}
  7.  
  8.  
  9. {---------------------------------------------------------------------}
  10. {$I EZDSLOPT.INC}
  11.  
  12. {$IFDEF Win32}
  13. {$APPTYPE CONSOLE}
  14. {$ENDIF}
  15.  
  16. uses
  17.   SysUtils,
  18.   DTstGen,
  19.   EZDSLBse,
  20.   EZDSLSup,
  21.   EZDSLBtr;
  22.  
  23. type
  24.   {A data object for non-duplicate strings}
  25.   PNoDupStr = ^TNoDupStr;
  26.   TNoDupStr = record
  27.     Seq : longint;
  28.     St  : TEZString;
  29.   end;
  30.  
  31.   {A red black tree for storing non-duplicate strings}
  32.   TStringRBTree = class(TrbSearchTree)
  33.     private
  34.       srbtSeq : longint;
  35.  
  36.     public
  37.       constructor Create;
  38.       procedure Insert (var Cursor : TTreeCursor; aData : pointer); override;
  39.   end;
  40.  
  41. var
  42.   DupCount : integer;
  43.  
  44. function NewNoDupStr(const S : string) : PNoDupStr;
  45.   {-Create a new no-dup string}
  46.   var
  47.     P : PNoDupStr;
  48.   begin
  49.     SafeGetMem(P, 5 + length(S));
  50.     P^.Seq := 0;
  51.     P^.St := S;
  52.     NewNoDupStr := P;
  53.   end;
  54.  
  55. procedure DisposeNoDupStr(P : PNoDupStr);
  56.   {-Dispose of a no-dup string}
  57.   begin
  58.     SafeFreeMem(P, 5 + length(P^.St));
  59.   end;
  60.  
  61. procedure MyDisposeData(aData : pointer); far;
  62.   {Our container's data disposal routine}
  63.   begin
  64.     DisposeNoDupStr(PNoDupStr(aData));
  65.   end;
  66.  
  67. function MyCompareData(Data1, Data2 : pointer) : integer; far;
  68.   {Our container's comparison routine - it'll increment DupCount when
  69.    two strings compare equal and then compare the sequence field}
  70.   var
  71.     P1 : PNoDupStr absolute Data1;
  72.     P2 : PNoDupStr absolute Data2;
  73.     Res : integer;
  74.   begin
  75.     Res := EZStrCompare(@P1^.St, @P2^.St);
  76.     if (Res = 0) then
  77.       begin
  78.         inc(DupCount);
  79.         if (P1^.Seq < P2^.Seq) then
  80.           Res := -1
  81.         else
  82.           Res := 1;
  83.       end;
  84.     MyCompareData := Res;
  85.   end;
  86.  
  87. constructor TStringRBTree.Create;
  88.   {Constructor for our container: zero the srbtSeq field, set our
  89.    data routines}
  90.   begin
  91.     inherited Create(true);
  92.     srbtSeq := 0;
  93.     SetCompare(MyCompareData);
  94.     SetDisposeData(MyDisposeData);
  95.   end;
  96.  
  97. procedure TStringRBTree.Insert (var Cursor : TTreeCursor; aData : pointer);
  98.   {Insert method for our container: sets the data object's sequence field
  99.    before insertion}
  100.   begin
  101.     inc(srbtSeq);
  102.     PNoDupStr(aData)^.Seq := srbtSeq;
  103.     inherited Insert(Cursor, aData);
  104.   end;
  105.  
  106. var
  107.   i : longint;
  108.   StrRBTree : TStringRBTree;
  109.   StartMem : longint;
  110.   Dummy : TTreeCursor;
  111.  
  112. begin
  113.   OpenLog;
  114.   try
  115.     {create a new string tree}
  116.     StrRBTree := TStringRBTree.Create;
  117.     try
  118.       {insert a bunch of string[3]'s - there are bound to be duplicates}
  119.       DupCount := 0;
  120.       with StrRBTree do
  121.         for i := 1 to 2000 do
  122.           Insert(Dummy, NewNoDupStr(RandomStr(3)));
  123.  
  124.       WriteLog(Format('There are %d duplicates in the tree', [DupCount]));
  125.       WriteLog(Format('There are %d items in the tree', [StrRBTree.Count]));
  126.     finally
  127.       {destroy the tree}
  128.       StrRBTree.Free;
  129.     end;
  130.   finally
  131.     CloseLog;
  132.   end;
  133. end.
  134.